hogwarts <- read_csv("data/hogwarts_2024.csv")
hogwarts |> head()
## # A tibble: 6 × 60
## id house course sex wandCore bloodStatus result Defence against the …¹
## <dbl> <chr> <dbl> <chr> <chr> <chr> <dbl> <dbl>
## 1 1 Ravencl… 4 fema… unicorn… half-blood 94 73
## 2 2 Hufflep… 5 male phoenix… half-blood 33 38
## 3 3 Ravencl… 4 fema… dragon … half-blood 137 52
## 4 4 Hufflep… 2 male phoenix… half-blood 27 50
## 5 5 Hufflep… 2 fema… phoenix… half-blood 67 47
## 6 6 Gryffin… 6 male phoenix… muggle-born 126 44
## # ℹ abbreviated name: ¹`Defence against the dark arts exam`
## # ℹ 52 more variables: `Flying exam` <dbl>, `Astronomy exam` <dbl>,
## # `Herbology exam` <dbl>, `Divinations exam` <dbl>, `Charms exam` <dbl>,
## # `History of magic exam` <dbl>, `Arithmancy exam` <dbl>,
## # `Care of magical creatures exam` <dbl>, `Muggle studies exam` <dbl>,
## # `Study of ancient runes exam` <dbl>, `Transfiguration exam` <dbl>,
## # `Potions exam` <dbl>, week_1 <dbl>, week_2 <dbl>, week_3 <dbl>, …
hogwarts |> glimpse()
## Rows: 560
## Columns: 60
## $ id <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11…
## $ house <chr> "Ravenclaw", "Hufflepuff", "Raven…
## $ course <dbl> 4, 5, 4, 2, 2, 6, 7, 5, 2, 3, 7, …
## $ sex <chr> "female", "male", "female", "male…
## $ wandCore <chr> "unicorn hair", "phoenix feather"…
## $ bloodStatus <chr> "half-blood", "half-blood", "half…
## $ result <dbl> 94, 33, 137, 27, 67, 126, 63, 7, …
## $ `Defence against the dark arts exam` <dbl> 73, 38, 52, 50, 47, 44, 51, 47, 2…
## $ `Flying exam` <dbl> 33, 36, 73, 42, 41, 52, 34, 34, 2…
## $ `Astronomy exam` <dbl> 57, 45, 66, 49, 57, 59, 58, 37, 5…
## $ `Herbology exam` <dbl> 73, 50, 62, 39, 38, 46, 59, 23, 2…
## $ `Divinations exam` <dbl> 66, 54, 72, 42, 47, 49, 42, 38, 1…
## $ `Charms exam` <dbl> 60, 70, 77, 46, 35, 55, 86, 20, 4…
## $ `History of magic exam` <dbl> 52, 36, 60, 45, 50, 40, 55, 21, 2…
## $ `Arithmancy exam` <dbl> 61, 36, 58, 32, 76, 50, 41, 31, 2…
## $ `Care of magical creatures exam` <dbl> 44, 41, 70, 36, 46, 73, 29, 36, 4…
## $ `Muggle studies exam` <dbl> 64, 34, 52, 59, 50, 54, 36, 31, 4…
## $ `Study of ancient runes exam` <dbl> 50, 35, 59, 39, 48, 56, 47, 41, 3…
## $ `Transfiguration exam` <dbl> 74, 70, 70, 15, 32, 86, 100, 31, …
## $ `Potions exam` <dbl> 67, 38, 22, 64, 56, 60, 62, 55, 1…
## $ week_1 <dbl> 0, -5, 0, -1, 1, 5, 1, -20, 3, -2…
## $ week_2 <dbl> -10, 1, 0, 5, 20, 10, -5, 10, 1, …
## $ week_3 <dbl> 0, -1, 1, -5, 10, -5, 3, -5, -3, …
## $ week_4 <dbl> 10, 1, -1, 10, -10, 10, 0, -10, -…
## $ week_5 <dbl> 3, -5, 3, 0, -1, 20, 5, 5, -3, 5,…
## $ week_6 <dbl> -20, 20, 0, 0, 0, 0, 0, 5, 0, -1,…
## $ week_7 <dbl> 10, 10, 1, -3, -20, 1, 10, 3, -5,…
## $ week_8 <dbl> 5, 5, 1, -5, 5, 5, 0, 1, 0, 20, -…
## $ week_9 <dbl> 1, 1, 3, -1, 0, 3, -20, -20, -10,…
## $ week_10 <dbl> 20, -10, 1, 5, -1, 0, 5, -5, 5, 3…
## $ week_11 <dbl> 5, -10, 20, 0, 0, 0, 5, 10, 5, 5,…
## $ week_12 <dbl> 5, -5, 1, -20, -10, -5, 0, 5, 1, …
## $ week_13 <dbl> -20, -5, 10, 0, 0, 1, -1, 10, -20…
## $ week_14 <dbl> 0, 5, 3, 10, -10, 20, 0, -20, -20…
## $ week_15 <dbl> 1, 20, 1, 0, -20, 10, 1, 3, -20, …
## $ week_16 <dbl> 20, 5, 5, 5, 0, 3, 10, -1, 5, 5, …
## $ week_17 <dbl> 3, 0, 10, 5, 5, -5, -1, 10, -10, …
## $ week_18 <dbl> 10, 5, 5, 5, 10, -20, 0, 10, 3, 5…
## $ week_19 <dbl> -10, 0, -5, -1, 0, -1, 0, 20, 0, …
## $ week_20 <dbl> 10, -10, 5, 10, 0, -1, -1, 10, 0,…
## $ week_21 <dbl> 0, 5, 5, 3, 5, 0, 0, -5, -5, 5, 5…
## $ week_22 <dbl> 20, -5, 5, 0, 20, 5, -1, 0, 0, 20…
## $ week_23 <dbl> 5, 1, -3, 20, -5, 20, 0, 1, 1, 5,…
## $ week_24 <dbl> 10, -20, -20, 0, 10, 5, 5, -3, -5…
## $ week_25 <dbl> 0, -20, 1, 3, 5, 1, -5, 0, -20, 2…
## $ week_26 <dbl> 10, 10, 5, -1, 0, 5, 5, -3, 0, 20…
## $ week_27 <dbl> 5, 5, -3, 0, 20, 5, 0, -5, 10, 3,…
## $ week_28 <dbl> -3, 20, 20, 1, 10, 5, 1, 10, 0, 1…
## $ week_29 <dbl> -20, -5, 5, 5, -10, 1, 0, -3, 0, …
## $ week_30 <dbl> 5, 1, -5, 5, -5, -1, -20, 20, 1, …
## $ week_31 <dbl> 5, 5, 20, -5, -10, -3, 0, -10, 20…
## $ week_32 <dbl> -5, 1, 20, -1, -10, 5, 10, 1, 0, …
## $ week_33 <dbl> 0, 10, 3, 3, 0, 0, -1, 0, -20, 3,…
## $ week_34 <dbl> 0, -1, 0, 0, 10, 3, 20, -5, 10, 3…
## $ week_35 <dbl> 5, -5, 3, -10, 3, -5, 0, 0, 0, 0,…
## $ week_36 <dbl> 1, 5, 1, -20, 5, 20, -1, -3, 1, 3…
## $ week_37 <dbl> 0, 0, 10, -1, 10, 3, 3, 0, 20, 1,…
## $ week_38 <dbl> 10, -1, 0, -5, 5, 5, 20, -5, -3, …
## $ week_39 <dbl> 3, 5, 1, 10, 20, 0, 5, 1, -5, 0, …
## $ week_40 <dbl> 0, 0, 5, 1, 5, 1, 10, -5, -20, 3,…
hogwarts <- hogwarts |> mutate(
across(c(house, course, sex, wandCore, bloodStatus), ~ as.factor(.x))
)
theme_custom <- theme(
axis.text = element_text(size = 20),
axis.title = element_text(size = 25),
legend.text = element_text(size = 20),
legend.title = element_text(size = 20),
plot.title = element_text(size = 25, hjust = 0.5),
strip.text = element_text(size = 25)
)
ggplot(hogwarts)+
geom_point(aes(x = result, y = `Herbology exam`), size = 3)+
geom_smooth(aes(x = result, y = `Herbology exam`), method = "lm", se = FALSE, color = "red")+
labs(
title = "Суммарный балл vs Оценка за экзамен по травологии",
x = "Суммарный балл за год",
y = "Оценка за экзамен по травологии"
)+
theme_bw()+
theme_custom
График показывает положительную линейную зависимость между общим годовым
баллом и оценкой за экзамен по травологии. Это подтверждается восходящим
наклоном линии тренда. Распределение данных указывает на то, что высокие
итоговые баллы чаще встречаются у успешных студентов, которые обычно
получают хорошие оценки и по другим предметам. Однако заметны некоторые
отклонения, особенно среди студентов с низкими баллами, что может
свидетельствовать о разных уровнях успеваемости среди учащихся.
house_colors <- c("Gryffindor" = "#C50000",
"Hufflepuff" = "#ECB939",
"Ravenclaw" = "#41A6D9",
"Slytherin" = "#1F5D25")
hogwarts %>%
pivot_longer(cols = c(`Herbology exam`, `Muggle studies exam`,
`Divinations exam`, `Potions exam`),
names_to = "exam",
values_to = "score") %>%
mutate(exam = recode(exam,
`Herbology exam` = "Экзамен по травологии",
`Muggle studies exam` = "Экзамен по магловедению",
`Divinations exam` = "Экзамен по прорицаниям",
`Potions exam` = "Экзамен по зельеварению")) %>%
ggplot(aes(x = result, y = score, color = house)) +
geom_point(size = 3) +
geom_smooth(method = "lm", se = FALSE) +
facet_wrap(~ exam, scales = "free_y") +
scale_color_manual(values = house_colors) +
labs(
title = "Скаттерплоты для различных экзаменов с линиями тренда",
x = "Суммарный балл за год",
y = "Оценка за экзамен"
) +
theme_bw()+
theme_custom
На экзаменах по прорицаниям, травологии и магловедению наблюдается положительная корреляция между итоговым баллом студента и оценкой за экзамен. Однако на экзамене по зельеварению линейная зависимость отсутствует, и успешность может зависеть от других факторов.
hogwarts %>%
pivot_longer(cols = c(`Herbology exam`, `Muggle studies exam`,
`Divinations exam`, `Potions exam`),
names_to = "exam",
values_to = "score") %>%
mutate(exam = recode(exam,
`Herbology exam` = "Экзамен по травологии",
`Muggle studies exam` = "Экзамен по магловедению",
`Divinations exam` = "Экзамен по прорицаниям",
`Potions exam` = "Экзамен по зельеварению")) %>%
ggplot(aes(x = result, y = score, color = house)) +
geom_point() +
geom_smooth(aes(group = sex, color = sex), method = "lm", se = FALSE, linetype = "solid") +
facet_wrap(~ exam, scales = "free") +
labs(
title = "Скаттерплоты для различных экзаменов с линиями тренда по полу",
x = "Суммарный балл за год",
y = "Оценка за экзамен"
) +
scale_fill_manual(values = c("Gryffindor" = "#C50000",
"Hufflepuff" = "#ECB939",
"Ravenclaw" = "#41A6D9",
"Slytherin" = "#1F5D25"))+
theme_bw() +
theme_custom
## geom_col и вещи вокруг него
hogwarts_semester1 <- hogwarts %>%
select(id, bloodStatus, starts_with("week_")) %>%
select(1:17) %>%
mutate(total_points_sem1 = rowSums(select(., starts_with("week_")))) %>%
group_by(bloodStatus) %>%
summarise(total_points_sem1 = sum(total_points_sem1))
ggplot(hogwarts_semester1, aes(x = bloodStatus, y = total_points_sem1, fill = bloodStatus))+
geom_bar(stat = "identity")+
labs(title = "Распределение набранных баллов за 1-й семестр по происхождению студентов",
x = "Происхождение",
y = "Набранные баллы за 1-й семестр")+
theme_bw()+
theme_custom
Одной из ключевых причин такого распределения баллов может быть то, что
полукровок значительно больше, чем чистокровных и магглорождённых
студентов. Это объясняет, почему они получили больше итоговых
баллов.
Поскольку полукровок больше, общее количество баллов, заработанных ими за первый семестр, будет выше из-за большего числа участников в этой группе, даже если их средние баллы аналогичны другим группам.
hogwarts_semester1 <- hogwarts %>%
select(id, bloodStatus, starts_with("week_")) %>%
select(1:17) %>%
mutate(total_points_sem1 = rowSums(select(., starts_with("week_")))) %>%
group_by(bloodStatus) %>%
summarise(total_points = sum(total_points_sem1),
num_students = n()) %>%
arrange(desc(total_points))
ggplot(hogwarts_semester1, aes(x = reorder(bloodStatus, -total_points), y = total_points, fill = bloodStatus))+
geom_bar(stat = "identity")+
geom_label(aes(label = paste0("Число студентов: ", num_students)),
size = 5, fill = "white", color = "black", label.padding = unit(0.25, "lines"))+
labs(title = "Распределение набранных баллов за 1-й семестр по происхождению студентов",
x = "Происхождение студентов",
y = "Сумма набранных баллов за 1-й семестр")+
theme_bw()+
theme_custom
График подтверждает гипотезу о том, что основная причина такого высокого
результата у студентов-полукровок — высокое количество студентов в этой
группе.
hogwarts_semester1 <- hogwarts %>%
select(id, bloodStatus, sex, starts_with("week_")) %>%
select(1:17) %>%
mutate(total_points_sem1 = rowSums(select(., starts_with("week_")))) %>%
group_by(bloodStatus, sex) %>%
summarise(total_points = sum(total_points_sem1),
num_students = n(), .groups = 'drop') %>%
arrange(desc(total_points))
ggplot(hogwarts_semester1, aes(x = reorder(bloodStatus, -total_points), y = total_points, fill = bloodStatus))+
geom_bar(stat = "identity", position = position_dodge())+
geom_label(aes(label = paste0("Кол-во: ", num_students)),
size = 4, fill = "white", color = "black",
label.padding = unit(0.25, "lines"),
position = position_dodge(width = 0.9), hjust = -0.2)+
scale_y_continuous(breaks = seq(0, max(hogwarts_semester1$total_points), by = 1000))+
labs(title = "Распределение набранных баллов за 1-й семестр по происхождению и полу студентов",
x = "Происхождение студентов",
y = "Сумма набранных баллов за 1-й семестр")+
theme_bw()+
theme_custom+
theme(axis.text.x = element_text(angle = 45, hjust = 1))+
facet_grid(. ~ sex)
ggsave("hogwarts_semester1_plot_facet.png", width = 10, height = 8)
Функция coord_flip() в ggplot2 позволяет поменять оси местами, улучшая читаемость и облегчая сравнение значений. Это полезно в разных ситуациях: для улучшения читаемости, сравнения категорий и изменения представления данных. Плюсы: улучшение читаемости, наглядность сравнения. Минусы: потеря привычного восприятия и сложности с легендой.
exam_scores <- hogwarts %>%
select(`Potions exam`, `Study of ancient runes exam`) %>%
pivot_longer(cols = everything(), names_to = "exam", values_to = "score")
hist_plot <- ggplot(exam_scores, aes(x = score, fill = exam))+
geom_histogram(position = "identity", alpha = 0.6, bins = 30)+
labs(title = "Гистограмма баллов за экзамены",
x = "Баллы",
y = "Число студентов")+
theme_minimal()
box_plot <- ggplot(exam_scores, aes(x = exam, y = score, fill = exam))+
geom_boxplot()+
labs(title = "Ящик с усами: Баллы за экзамены",
x = "Экзамен",
y = "Баллы")+
theme_minimal()
density_plot <- ggplot(exam_scores, aes(x = score, fill = exam))+
geom_density(alpha = 0.5)+
labs(title = "Плотность распределения баллов за экзамены",
x = "Баллы",
y = "Плотность")+
theme_minimal()
combined_plot <- (hist_plot | box_plot) / density_plot
combined_plot
Скорректируйте название оси. Если у вас возникают сложности, обратитесь к шпаргалке по пакету forcats от posit. (Дополнительные 0.5 б.)
average_scores <- hogwarts %>%
group_by(bloodStatus) %>%
summarise(avg_potions_score = mean(`Potions exam`, na.rm = TRUE)) %>%
mutate(bloodStatus = fct_relevel(bloodStatus, "muggle-born", "pure-blood", "half-blood"))
avg_potions_plot <- ggplot(average_scores, aes(x = bloodStatus, y = avg_potions_score, fill = bloodStatus))+
geom_bar(stat = "identity", position = "dodge")+
labs(title = "Средний балл по зельеварению по происхождению студентов",
x = "Происхождение",
y = "Средний балл за экзамен по зельеварению")+
theme_minimal()
boxplot_potions <- ggplot(hogwarts, aes(x = bloodStatus, y = `Potions exam`, fill = bloodStatus))+
geom_boxplot()+
labs(title = "Распределение баллов по зельеварению",
x = "Происхождение",
y = "Баллы за экзамен по зельеварению")+
theme_minimal()
combined_plot <- ggarrange(avg_potions_plot, boxplot_potions, nrow = 2, ncol = 1)
combined_plot
ggsave("average_potions_distribution.png", plot = combined_plot, width = 8, height = 10)
Интерпретация результатов Мы видим, что маглорожденные студенты имеют более высокий средний балл по зельеварению, чем полукровные и чистокровные. Это может быть связано с тем, что маглорожденные студенты, возможно, более мотивированы или используют разные подходы к обучению, нежели чистокровные.
hogwarts %>%
ggplot(aes(x = house, y = result, fill = house))+
geom_violin(trim = TRUE, scale = "area")+
geom_boxplot(width = 0.1, fill = "white")+
stat_summary(fun = "mean", geom = "point", shape = 23, size = 3, fill = "brown")+
facet_wrap(~ sex, labeller = as_labeller(c("male" = "Мальчики", "female" = "Девочки")))+
scale_y_continuous(breaks = seq(-300, 300, by = 50))+
geom_hline(yintercept = 0, linetype = "dashed", color = "red", linewidth = 1.2)+
scale_fill_manual(values = c("Gryffindor" = "#C50000",
"Hufflepuff" = "#ECB939",
"Ravenclaw" = "#41A6D9",
"Slytherin" = "#1F5D25"))+
labs(
title = "Баллы студентов Хогвартса",
subtitle = "Распределение числа баллов у студентов различных факультетов Хогвартса в 2023-2024 учебном году",
x = "",
y = "Количество очков",
fill = "Факультет"
)+
theme_classic()+
theme(
plot.title = element_text(hjust = 0.5, size = 18),
plot.subtitle = element_text(hjust = 0.5, size = 14, color = "brown"),
axis.title.y = element_text(size = 14),
axis.text.x = element_blank(),
strip.text = element_text(size = 14),
legend.title = element_text(size = 12),
legend.text = element_text(size = 10),
legend.position = c(.5, .2),
legend.background = element_rect(fill = "transparent", colour = NA),
legend.key = element_rect(fill = "transparent", colour = NA),
strip.background = element_rect(fill = "gray90", colour = NA),
panel.border = element_blank(),
axis.line = element_blank(),
axis.ticks = element_line(color = "black")
)
На графике представлено распределение баллов среди студентов факультетов
Хогвартса за учебный год 2023-2024.
Основные наблюдения: Половые различия: График не выявляет значительных различий в оценках между мальчиками и девочками, за исключением студентов Слизерина, где наблюдаются определённые отличия.